Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH11/SRC/OBJTRANS.CLS

Text File | 1996-05-04 | 10KB | 362 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ObjTransformed"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

Private NumCurvePts As Integer
Private CurvePoints() As Point3D

Private NumTrans As Integer
Private trans() As Transformation

Private solid As ObjSolid   ' The display solid.
' ************************************************
' Add a point to the curve.
' ************************************************
Public Sub AddCurvePoint(x As Single, Y As Single, z As Single)
    NumCurvePts = NumCurvePts + 1
    ReDim Preserve CurvePoints(1 To NumCurvePts)
    CurvePoints(NumCurvePts).coord(1) = x
    CurvePoints(NumCurvePts).coord(2) = Y
    CurvePoints(NumCurvePts).coord(3) = z
    CurvePoints(NumCurvePts).coord(4) = 1
End Sub




' ************************************************
' Set a transformation.
' ************************************************
Public Sub SetTrans(M() As Single)
    NumTrans = NumTrans + 1
    ReDim Preserve trans(1 To NumTrans)
    m3MatCopy trans(NumTrans).M, M
End Sub

' ************************************************
' Return the solid's Zmax value.
' ************************************************
Public Function zmax() As Single
    If solid Is Nothing Then
        zmax = -INFINITY
    Else
        zmax = solid.zmax
    End If
End Function
' ************************************************
' Make the solid compute its Zmax value.
' ************************************************
Public Sub SetZmax()
    If Not solid Is Nothing Then solid.SetZmax
End Sub


' ************************************************
' Create the display solid by applying the
' series of transformations in array M().
' ************************************************
Public Sub Transform(Optional cap_ends As Variant)
Dim pgon As ObjPolygon
Dim i As Integer
Dim j As Integer
Dim x0 As Single
Dim y0 As Single
Dim z0 As Single
Dim x1 As Single
Dim y1 As Single
Dim z1 As Single
Dim x2 As Single
Dim y2 As Single
Dim z2 As Single
Dim x3 As Single
Dim y3 As Single
Dim z3 As Single

    If IsMissing(cap_ends) Then cap_ends = True

    Set solid = New ObjSolid

    ' Add the base curve to solid assuming the
    ' curve is stored oriented towards the
    ' transformations.
    If cap_ends Then
        Set pgon = New ObjPolygon
        solid.AddPolygon pgon
        For i = NumCurvePts - 1 To 1 Step -1
            pgon.AddPoint _
                CurvePoints(i).coord(1), _
                CurvePoints(i).coord(2), _
                CurvePoints(i).coord(3)
        Next i
    End If

    ' Start with the transformed coordinates
    ' the same as the original coordinates.
    For i = 1 To NumCurvePts
        CurvePoints(i).trans(1) = CurvePoints(i).coord(1)
        CurvePoints(i).trans(2) = CurvePoints(i).coord(2)
        CurvePoints(i).trans(3) = CurvePoints(i).coord(3)
    Next i

    ' Create the transformed copies of the curve.
    For i = 1 To NumTrans
        x0 = CurvePoints(1).trans(1)
        y0 = CurvePoints(1).trans(2)
        z0 = CurvePoints(1).trans(3)
        m3ApplyFull _
            CurvePoints(1).coord, trans(i).M, _
            CurvePoints(1).trans
        x1 = CurvePoints(1).trans(1)
        y1 = CurvePoints(1).trans(2)
        z1 = CurvePoints(1).trans(3)

        For j = 2 To NumCurvePts
            x2 = CurvePoints(j).trans(1)
            y2 = CurvePoints(j).trans(2)
            z2 = CurvePoints(j).trans(3)
            m3ApplyFull _
                CurvePoints(j).coord, trans(i).M, _
                CurvePoints(j).trans
            x3 = CurvePoints(j).trans(1)
            y3 = CurvePoints(j).trans(2)
            z3 = CurvePoints(j).trans(3)

            solid.AddFace _
                x0, y0, z0, _
                x2, y2, z2, _
                x1, y1, z1

            solid.AddFace _
                x2, y2, z2, _
                x3, y3, z3, _
                x1, y1, z1
            x0 = x2
            y0 = y2
            z0 = z2
            x1 = x3
            y1 = y3
            z1 = z3
        Next j
    Next i

    ' Add the final curve to solid assuming
    ' the curve is stored oriented towards the
    ' transformations.
    If cap_ends Then
        Set pgon = New ObjPolygon
        solid.AddPolygon pgon
        For i = 2 To NumCurvePts
            pgon.AddPoint _
                CurvePoints(i).trans(1), _
                CurvePoints(i).trans(2), _
                CurvePoints(i).trans(3)
        Next i
    End If
End Sub

' ***********************************************
' Return a string indicating the object type.
' ***********************************************
Property Get ObjectType() As String
    ObjectType = "TRANSFORMED"
End Property



' ***********************************************
' Fix the data coordinates at their transformed
' values.
' ***********************************************
Public Sub FixPoints()
Dim i As Integer
Dim j As Integer

    ' Fix the curve points.
    For i = 1 To NumCurvePts
        For j = 1 To 3
            CurvePoints(i).coord(j) = CurvePoints(i).trans(j)
        Next j
    Next i

    ' Fix the display solid if it exists.
    If Not solid Is Nothing Then solid.FixPoints
End Sub

' ************************************************
' Apply a transformation matrix which may not
' contain 0, 0, 0, 1 in the last column to the
' object.
' ************************************************
Public Sub ApplyFull(M() As Single)
Dim i As Integer

    ' Transform the curve.
    For i = 1 To NumCurvePts
        m3ApplyFull CurvePoints(i).coord, M, _
                    CurvePoints(i).trans
    Next i

    ' Transform the display solid if it exists.
    If Not solid Is Nothing Then solid.ApplyFull M
End Sub

' ************************************************
' Apply a transformation matrix to the object.
' ************************************************
Public Sub Apply(M() As Single)
Dim i As Integer

    ' Transform the curve.
    For i = 1 To NumCurvePts
        m3Apply CurvePoints(i).coord, M, _
                CurvePoints(i).trans
    Next i

    ' Transform the display solid if it exists.
    If Not solid Is Nothing Then solid.Apply M
End Sub


' ************************************************
' Apply a nonlinear transformation.
' ************************************************
Public Sub Distort(D As Object)
Dim i As Integer

    ' Distort the curve.
    For i = 1 To NumCurvePts
        D.Distort CurvePoints(i).coord(1), _
                  CurvePoints(i).coord(2), _
                  CurvePoints(i).coord(3)
    Next i

    ' Distort the display solid if it exists.
    If Not solid Is Nothing Then solid.Distort D
End Sub


' ************************************************
' Write the surface's display solid object to a
' file using Write. The data can later be loaded
' into an Objsolid object but not an
' ObjRotated object.
' ************************************************
Public Sub FileWriteSolid(filenum As Integer)
Dim M(1 To 4, 1 To 4) As Single


    If Not solid Is Nothing Then solid.FileWrite filenum
End Sub


' ************************************************
' Write an extruded surface to a file using Write.
' Begin with "TRANSFORMED" to identify this object.
' ************************************************
Public Sub FileWrite(filenum As Integer)
Dim i As Integer
Dim j As Integer
Dim k As Integer

    ' Write basic information.
    Write #filenum, "TRANSFORMED", NumCurvePts, _
        NumTrans

    ' Write the curve points.
    For i = 1 To NumCurvePts
        Write #filenum, _
            CurvePoints(i).coord(1), _
            CurvePoints(i).coord(2), _
            CurvePoints(i).coord(3)
    Next i

    ' Write the transformations.
    For i = 1 To NumTrans
        For j = 1 To 4
            For k = 1 To 4
                Write #filenum, trans(i).M(j, k)
            Next k
        Next j
    Next i
End Sub




' ************************************************
' Draw the extrusion on a Form, Printer, or
' PictureBox.
' ************************************************
Public Sub Draw(canvas As Object, Optional r As Variant)
    If Not solid Is Nothing Then _
        solid.Draw canvas, r
End Sub


' ************************************************
' Perform backface removal on the display solid.
' ************************************************
Public Sub Cull(x As Single, Y As Single, z As Single)
    If Not solid Is Nothing Then solid.Cull x, Y, z
End Sub

' ***********************************************
' Set or clear the Culled property for the solid.
' ***********************************************
Property Let Culled(value As Boolean)
    If Not solid Is Nothing Then solid.Culled = value
End Property
' ************************************************
' Draw the transformed display solid on a Form,
' Printer, or PictureBox. Draw the faces in
' depth-sort order.
' ************************************************
Public Sub DrawOrdered(canvas As Object, Optional r As Variant)
    If Not solid Is Nothing Then solid.DrawOrdered canvas, r
End Sub


' ************************************************
' Read a grid from a file using Input.
' Assume the "TRANSFORMED" label has already been
' read.
' ************************************************
Public Sub FileInput(filenum As Integer)
Dim i As Integer
Dim j As Integer
Dim k As Integer

    ' Get the basic information.
    Input #filenum, NumCurvePts, NumTrans

    ' Allocate and read the curve array.
    ReDim CurvePoints(1 To NumCurvePts)
    For i = 1 To NumCurvePts
        Input #filenum, _
            CurvePoints(i).coord(1), _
            CurvePoints(i).coord(2), _
            CurvePoints(i).coord(3)
        CurvePoints(i).coord(4) = 1
    Next i

    ' Allocate and read the transformations.
    ReDim trans(1 To NumTrans)
    For i = 1 To NumTrans
        For j = 1 To 4
            For k = 1 To 4
                Input #filenum, trans(i).M(j, k)
            Next k
        Next j
    Next i

    ' Create the display solid.
    Transform
End Sub